{-# LANGUAGE ViewPatterns, DeriveDataTypeable #-}
----------------------------------------------------------------
--                                                            --
-- Module      :  LLVM.Code.Instructions.Values               --
-- License     :  GPL3                                        --
-- Mantainer   :  Mikhail Belyaev                             --
--                                                            --
----------------------------------------------------------------

module LLVM.Code.Instructions.Values where

import Data.Generics(Typeable, Data)

import LLVM.Code.Shared (CmpOpcode)
import LLVM.Code.Shared (CastOpcode)
import LLVM.Code.Shared (CallingConv)
import LLVM.Code.Shared (ParamAttrIndex(..))
import LLVM.Code.Shared (BBIndex(..))
import LLVM.Code.Shared (BinOpcode)
import LLVM.Code.Shared (ValIndex(..))
import LLVM.Code.Types
       (getTypeByIndex, TypeTable(..), Type(..), Type)

data DebugLoc = DebugLoc {
                    debugLine :: Integer,
                    debugCol :: Integer,
                    debugScope :: Integer, -- TODO: Metadata index (0 for no md, 1-based index for md)
                    debugIA :: Integer-- TODO: Metadata index (0 for no md, 1-based index for md)
                }deriving (Show,Eq,Typeable,Data)

data Instruction =
                   IBinary BinaryInstruction |
                   ICast CastInstruction |
                   IGEP GetElementPtrInstruction |
                   ISelect SelectInstruction |
                   IExtractEl ExtractElementInstruction |
                   IInsertEl InsertElementInstruction |
                   IShuffleVec ShuffleVecInstruction |
                   ICmp CmpInstruction |
                   IRet ReturnInstruction |
                   IBranch BranchInstruction |
                   ISwitch SwitchInstruction |
                   IInvoke InvokeInstruction |
                   IUnwind UnwindInstruction |
                   IUnreachable UnreachableInstruction |
                   IPhi PhiInstruction |
                   IMalloc MallocInstruction |
                   IFree FreeInstruction |
                   IAlloca AllocaInstruction |
                   ILoad LoadInstruction |
                   ICall CallInstruction |
                   IStore StoreInstruction |
                   IExtractV ExtractValueInstruction |
                   IInsertV InsertValueInstruction |
                   IIndirBr IndirBranchInstruction deriving (Show,Eq,Typeable,Data)

resTypeOf :: Instruction -> TypeTable -> Type
resTypeOf (IBinary i) _ = biType i
resTypeOf (ICast i) _ = ciResType i
resTypeOf (IGEP i) _ = gepValType i
resTypeOf (ISelect i) _ = selOpType i
resTypeOf (IExtractEl i) _ = extractElType i
resTypeOf (IInsertEl i) _ = insertElType i
resTypeOf (IShuffleVec i) _ = shuffleType i
resTypeOf (ICmp i) _ = LLInt 1
resTypeOf (IRet i) _ = LLVoid
resTypeOf (IBranch i) _ = LLVoid
resTypeOf (ISwitch i) _ = LLVoid
resTypeOf (IInvoke i) _ = LLVoid
resTypeOf (IUnwind i) _ = LLVoid
resTypeOf (IUnreachable i) _ = LLOpaque
resTypeOf (IPhi i) _ = phiType i
resTypeOf (IMalloc i) _ = mallocType i
resTypeOf (IFree i) _ = LLVoid
resTypeOf (IAlloca i) _ = allocaType i
resTypeOf (ILoad i) tt = case (loadPtType i) of
                               LLPointer (getTypeByIndex tt -> Just tp) _ -> tp
                               _ -> LLOpaque
resTypeOf (ICall i) tt = case (callType i) of
                             (LLFunctionType (getTypeByIndex tt -> Just tp) _ _) -> tp
                             (LLPointer (getTypeByIndex tt -> Just f) _) ->
                                case f of
                                     (LLFunctionType (getTypeByIndex tt -> Just tp) _ _) -> tp
                                     _ -> LLOpaque
                             _ -> LLOpaque
resTypeOf (IStore i) _ = LLVoid
resTypeOf (IExtractV i) _ = extractValType i
resTypeOf (IInsertV i) _ = insertValType i
resTypeOf (IIndirBr i) _ = LLVoid

data ExtractElementInstruction = ExtractElementInstruction {
                                extractElType :: Type,
                                extractElVal :: ValIndex,
                                extractElIx :: ValIndex
                         } deriving (Show,Eq,Typeable,Data)

data InsertElementInstruction = InsertElementInstruction {
                                insertElType :: Type,
                                insertElVal :: ValIndex,
                                insertElElem :: ValIndex,
                                insertElIx :: ValIndex
                         } deriving (Show,Eq,Typeable,Data)



data ShuffleVecInstruction = ShuffleVecInstruction {
                                shuffleType :: Type,
                                shuffleVec1 :: ValIndex,
                                shuffleVec2 :: ValIndex,
                                shuffleMask :: ValIndex
                         } deriving (Show,Eq,Typeable,Data)

data ExtractValueInstruction = ExtractValueInstruction {
                                    extractValType :: Type,
                                    extractValVal :: ValIndex,
                                    extractValIx :: [Integer]
                               } deriving (Show,Eq,Typeable,Data)

data InsertValueInstruction = InsertValueInstruction {
                                    insertValType :: Type,
                                    insertValVal :: ValIndex,
                                    insertValElemType :: Type,
                                    insertValElem :: ValIndex,
                                    insertValIx :: [Integer]
                              } deriving (Show,Eq,Typeable,Data)


data GetElementPtrInstruction = GetElementPtrInstruction {
                                    gepValType :: Type,
                                    gepVal :: ValIndex,
                                    gepIxs :: [(Type,ValIndex)],
                                    gepIsInBounds :: Bool
                                } deriving (Show,Eq,Typeable,Data)


data BinaryInstruction = BinaryInstruction{
                            biOpcode :: BinOpcode,
                            biType :: Type,
                            biOp1 :: ValIndex,
                            biOp2 :: ValIndex
                         } deriving (Show,Eq,Typeable,Data)

-- branch is a conditional or non-conditional jump, code 11
data BranchInstruction = StraightBranch BBIndex | CondBranch BBIndex BBIndex ValIndex deriving (Show, Eq, Typeable, Data)


-- indirect branch is a non-conditional, but indirect jump, code 31
-- the adress of the destination comes from some value,
-- but a set of possible destinations must be given
data IndirBranchInstruction = IndirBranchInstruction {
                                    ibrType           :: Type,
                                    ibrVal            :: ValIndex,
                                    ibrPossibleValues :: [BBIndex]
                              } deriving (Show,Eq,Typeable,Data)

-- switch is a generalisation of branch to many values of condition, code 12
-- all values should be constants, but no one guarantees that
data SwitchInstruction = SwitchInstruction {
                            seOptype  :: Type,
                            swOpval   :: ValIndex,
                            swDefault :: BBIndex,
                            swCases   :: [(ValIndex,BBIndex)]
                         } deriving (Show,Eq,Typeable,Data)

data CallInstruction = CallInstruction {
                        callParamAttrs :: ParamAttrIndex,
                        callCConv :: CallingConv,
                        callType :: Type,
                        callFValue :: ValIndex,
                        callOperands :: [ValIndex]
                       } deriving (Show,Eq,Typeable,Data)


-- invoke works like this:
-- try {
--        call func(ops...);
--        goto bb1; // if it returns with `ret`
-- } catch (..) { // imagine `unwind` as `throw` ))
--        goto bb2; // if it returns with `unwind`
-- }
-- ...
-- bb1: ...
-- bb2: ...
-- so we naturally (unlike original llvm does) imply it is a branch with nested function call
-- as invoke is a branch, it is also a terminating instruction
data InvokeInstruction = InvokeInstruction {
                            normalBB :: BBIndex,
                            catchBB :: BBIndex,
                            nestedCall :: CallInstruction
                         } deriving (Show,Eq,Typeable,Data)

data ReturnInstruction = ReturnInstruction {
                            result :: Maybe (Type,ValIndex)
                         } deriving (Show,Eq,Typeable,Data)

-- Unwind is `throw` in form of an instruction
data UnwindInstruction = UnwindInstruction deriving (Show,Eq,Typeable,Data)


data UnreachableInstruction = UnreachableInstruction deriving (Show,Eq,Typeable,Data)


data CastInstruction = CastInstruction{
                            ciOpcode  :: CastOpcode,
                            ciResType :: Type,
                            ciOpType  :: Type,
                            ciOp      :: ValIndex
                         } deriving (Show,Eq,Typeable,Data)

data CmpInstruction = CmpInstruction {
                            cmpOpType :: Type,
                            cmpOp1Val :: ValIndex,
                            cmpOp2Val :: ValIndex,
                            cmpOpCode :: CmpOpcode
                        } deriving (Show,Eq,Typeable,Data)

data SelectInstruction = SelectInstruction {
                            selOpType :: Type,
                            selOpTrue :: ValIndex,
                            selOpFalse :: ValIndex,
                            selPred :: ValIndex -- int1 or [N x int1] for VSelect
                         } deriving (Show,Eq,Typeable,Data)


data PhiInstruction = PhiInstruction {
                            phiType :: Type,
                            phiVals :: [(ValIndex,BBIndex)]
                      } deriving (Show,Eq,Typeable,Data)

data MallocInstruction = MallocInstruction {
                            mallocType :: Type,
                            mallocOp :: ValIndex,
                            mallocAlign :: Integer
                         } deriving (Show,Eq,Typeable,Data)

data AllocaInstruction = AllocaInstruction {
                            allocaType :: Type,
                            allocaOpType :: Type,
                            allocaOp :: ValIndex,
                            allocaAlign :: Integer
                         } deriving (Show,Eq,Typeable,Data)

data FreeInstruction = FreeInstruction {
                            freeType :: Type,
                            freeValue :: ValIndex
                       } deriving (Show,Eq,Typeable,Data)



data LoadInstruction = LoadInstruction {
                            loadPtType :: Type,
                            loadPtr :: ValIndex,
                            loadAlign :: Integer,
                            loadIsVolatile :: Bool
                       } deriving (Show,Eq,Typeable,Data)



data StoreInstruction = StoreInstruction {
                            storePtType :: Type,
                            storePtr :: ValIndex,
                            storeVal :: ValIndex,
                            storeAlign :: Integer,
                            storeIsVolatile :: Bool
                       } deriving (Show,Eq,Typeable,Data)


